Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11pak.mac < prev next >

Wrap

Text File | 1989-06-12 | 58.0 KB | 2,051 lines

.title k11pak packet driver for kermit-11 .ident /8.0.01/ .enabl gbl ; Brian Nelson 30-Nov-83 10:20:09 ; Last edit: 02-Jul-85 14:44:32 ; ; Change Software, Toledo, Ohio ; University of Toledo, Toledo, Ohio ; .enabl lc ; define macros and things we want for KERMIT-11 ; ; K11MAC.MAC defines all macros and a number of symbols .include /IN:K11DEF.MAC/ .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed .include /IN:K11DEF.MAC/ maxpak == 94. ; maximum packet size-maxsize(checksum) mx$try == 10 ; number of times to retry packet myquote == '# ; quoting mypad == 0 ; no padding mypchar == 0 ; thus no pad character myeol == cr ; end-of-line mytime == 12 ; time me out after this myqbin == '& ; 8 bit quoting defchk == '1 mychkt == defchk ; normal checksumming myrept == 176 ; tilde for repeat things mycapa == capa.a+capa.l ; /42/ Attributes + long packets maxtim == 60 ; maximum timeout mintim == 2 ; minimum timeout badchk == 377 ; psuedo packet type for checksum timout == 'T&137 ; psuedo packet type for timeout defdly == 6 ; delay for SENDING to start up .sbttl notes on RMS-11 ; RSTS and RSX note: ; ; Note that we really don't need distinct luns for input, output ; and directory lookup as we would normally never have more than ; one of them active at any given time. The space used to do this ; only adds about 1 KW of size to the task so I am not going to ; worry about it. There could always come a time when the above ; assumption will not hold. Most of KERMIT-11 is sharable anyway ; due to the linking to RMSRES. The code, all being in PSECT $CODE ; can always be task built with the /MU switch to make more of it ; sharable (RSTS and RSX11M Plus only). ; The one thing to note is that LUN.LO must ALWAYS be reserved as ; logging and debugging to disk can be running concurrently with ; anything else. Also, when the TAKE command is put in another lun ; will be required for it. lun.kb == 0 ; assume if channel 0 --> terminal lun.in == 1 ; channel for input files lun.ou == 2 ; channel for output files lun.lo == 3 ; channel for packet and file logging lun.tr == 3 ; same as lun.log lun.ta == 4 ; for the TAKE command lun.tt == 5 ; for RSX, the normal TI: channel lun.sr == 6 ; channel for $search for RMSv2.0 lun.ti == 7 ; channel number for connected terminal lun.xk == 7 ; Ditto, for clarity lun.co == 10 ; used as is lin.ti for remote connect lun.as == 11 ; used to attach to remote link device ; to fake a device assignment .psect $pdata null: .byte 0,0 ; a null packet to send .psect $code .sbttl KERMIT packet format ; PACKET FORMAT ; ;The KERMIT protocol is built around exchange of packets of the following for- ;mat: ; ; +------+-----------+-----------+------+------------+-------+ ; ] MARK ] char(LEN) ] char(SEQ) ] TYPE ] DATA ] CHECK ] ; +------+-----------+-----------+------+------------+-------+ ; ;where all fields consist of ASCII characters. The fields are: ; ;MARK The synchronization character that marks the beginning of the packet. ; This should normally be CTRL-A, but may be redefined. ; ;LEN The number of ASCII characters within the packet that follow this ; field, in other words the packet length minus two. Since this number ; is transformed to a single character via the char() function, packet ; character counts of 0 to 94 (decimal) are permitted, and 96 (decimal) ; is the maximum total packet length. The length does not include end- ; of-line or padding characters, which are outside the packet and are ; strictly for the benefit of the operating system, but it does include ; the block check characters. ; ;SEQ The packet sequence number, modulo 64, ranging from 0 to 63. Sequence ; numbers "wrap around" to 0 after each group of 64 packets. ; ; ;TYPE The packet type, a single ASCII character. The following packet types ; are required: ; ; D Data packet ; Y Acknowledge (ACK) ; N Negative acknowledge (NAK) ; S Send initiate (exchange parameters) ; B Break transmission (EOT) ; F File header ; Z End of file (EOF) ; E Error ; ; ;DATA The "contents" of the packet, if any contents are required in the given ; type of packet, interpreted according to the packet type. Control ; characters are preceded by a special prefix character, normally "#", ; and "uncontrollified" via ctl(). A prefixed sequence may not be broken ; across packets. Logical records in printable files are delimited with ; CRLFs, suitably prefixed (e.g. "#M#J"). Any prefix characters are in- ; cluded in the count. Optional encoding for 8-bit data and repeated ; characters is described later. ; ; ;CHECK A block check on the characters in the packet between, but not includ- ; ing, the mark and the block check itself. The check for each packet is ; computed by both hosts, and must agree if a packet is to be accepted. ; A single-character arithmetic checksum is the normal and required block ; check. Only six bits of the arithmetic sum are included. In order ; that all the bits of each data character contribute to this quantity, ; bits 6 and 7 of the final value are added to the quantity formed by ; bits 0-5. Thus if s is the arithmetic sum of the ASCII characters, ; then ; ; check = char((s + ((s AND 192)/64)) AND 63) ; ; This is the default block check, and all Kermits must be capable of ; performing it. Other optional block check types are described later. ; The block check is based on the ASCII values of the characters in the ; packet. Non-ASCII systems must translate to ASCII before performing ; the block check calculation. ; ; ; ; 13-Oct-84 14:01:32 BDN moved SENDSW and RECSW out .sbttl GETCR0 decide where to get the next character from ; 06-Nov-85 11:22:14 BDN Added Edit 38 ; ; Passed: r0 LUN ; Return: r0 Error code (generally 0 or ER$EOF) ; r1 Character just read ; ; ; GETCR0 is the lowest level entry point called in Kermit to ; obtain the next character for a SEND function (even GETC ; calls it), where that it may be a normal file transfer, or ; a SERVER extended response. The main idea in altering it is ; so that a server dispatch routine can change the the ; default (get from a file) to, say, get from an .ASCIZ ; string in memory or switch to some other kind of ; GET_NEXT_CHARACTER routine. This requires that the service ; routine insert its GET_NEXT_CHAR routine address into the ; global 'GETCROUTINE' and also to reset it to 'FGETCR0' when ; the action is complete. Currenty, REMOTE HELP and REMOTE ; DIR use this facility. getcr0::tst getcroutine ; /38/is there any routine address set bne 10$ ; /38/yes call fgetcr0 ; /38/no, default to file reading br 100$ ; /38/exit 10$: call @getcroutine ; /38/call currently defined routine 100$: return tgetcr::tst tgetaddr ; /38/Have we ever been inited ? beq 90$ ; /38/no, return ER$EOF movb @tgetaddr,r1 ; /38/yes, get next character please beq 90$ ; /38/nothing is left to do inc tgetaddr ; /38/text_address++ clr r0 ; /38/return(no_errors) br 100$ ; /38/exit 90$: mov #ER$EOF ,r0 ; /38/return(end_of_file) mov #fgetcr0,getcroutine ; /38/reset to file reading please 100$: return ; /38/exit global <getcroutine,fgetcr0,tgetcr0,tgetaddr,ER$EOF> .sbttl spack send packet ; S P A C K $ ; ; spack$(%val type,%val num,%val len, %loc data) ; ; input: @r5 type of packet ; 2(r5) packet number ; 4(r5) length of the packet ; 6(r5) location of the data to send ; output: r0 error status $ALLSIZ = <MAXLNG+<MAXLNG/10>>&177776 spack$::save <r1,r2,r3,r4> ; Save registers that we may use call spakwa call spakin sub #$ALLSIZ,sp ; /42/ Allocate a LONG buffer mov sp ,r4 ; Point to the buffer clr -(sp) ; Count the total length tst prexon ; /53/ Should we prefix all packets beq 5$ ; /53/ with an XON? If eq, NO movb #'Q&37 ,(r4)+ ; /53/ Yes, insert one inc @sp ; /53/ Write_length++ 5$: setpar sensop ,(r4)+ ; Start all packets with control A mov r4 ,r2 ; Get address for checksum compute inc @sp ; Packetlength := succ(packetlength) mov 4(r5) ,r0 ; The length of the packet cmp r0 ,#MAXPAK ; Packet too large ? blos 15$ ; No bitb #CAPA.L,conpar+p.capas ; /43/ Check to see if both sides beq 10$ ; /43/ REALLY understand long packets bitb #CAPA.L,senpar+p.capas ; /43/ We would normally but it is beq 10$ ; /43/ possible to SET NOLONG tst senlng ; /42/ Receiver said it can do long beq 10$ ; /42/ packets? If eq, then no ; /42/ Otherwise, build ext header. mov r2 ,-(sp) ; /42/ Save this mov #40 ,-(sp) ; /42/ Accumulate header checksum setpar #40 ,(r4)+ ; /42/ Length is a space, of course. tochar 2(r5) ,r1 ; /42/ Packet sequence please add r1 ,(sp) ; /42/ Add into header checksum now. setpar r1 ,(r4)+ ; /42/ Insert it movb (r5) ,r1 ; /42/ The packet type is next. bicb #40 ,r1 ; /42/ Insure always upper case. add r1 ,(sp) ; /42/ Add in the checksum setpar r1 ,(r4)+ ; /42/ And insert that also mov r0 ,r3 ; /42/ Insert the total packet size clr r2 ; /42/ First byte is size/95. add chksiz ,r3 ; /42/ Must include checksum size. div #95. ,r2 ; /42/ Second byte is size mod 95 tochar r2 ,r2 ; /42/ Convert to character rep tochar r3 ,r3 ; /42/ Convert to character rep setpar r2 ,(r4)+ ; /42/ Insert high bits into packet add r2 ,(sp) ; /42/ Add into checksum setpar r3 ,(r4)+ ; /42/ Insert low bits into packet add r3 ,(sp) ; /42/ Add into checksum mov (sp)+ ,r0 ; /42/ Pop the checksum please mov r0 ,r2 ; /42/ Save it bic #^C300 ,r2 ; /42/ Compute it as in: ash #-6 ,r2 ; /42/ Chk=char((s+((s&0300)/0100))&77) add r0 ,r2 ; /42/ ... bic #^C77 ,r2 ; /42/ Got it now tochar r2 ,r2 ; /42/ Convert checksum to character setpar r2 ,(r4)+ ; /42/ and insert into packet. mov (sp)+ ,r2 ; /42/ Where to start checksum for rest mov #7 ,(sp) ; /42/ We now have seven characters. br 20$ ; /42/ Add off we go 10$: mov #MAXPAK-3,r0 ; Yes, reset packet size please 15$: add #2 ,r0 ; + two for number and type add chksiz ,r0 ; + the length of the checksum please clr r1 ; Accumulated checksum tochar r0 ,r1 ; Start the checksum out right setpar r1 ,(r4)+ ; And stuff length into the packet inc @sp ; Packetlength := succ(packetlength) tochar 2(r5) ,r0 ; Convert the packet number now setpar r0 ,(r4)+ ; And stuff it into the packet inc @sp ; Packetlength := succ(packetlength) movb @r5 ,r0 ; Get the packet type now bicb #40 ,r0 ; Insure UPPER CASE packet type setpar r0 ,(r4)+ ; Insert the packet type into buffer inc @sp ; Packetlength := succ(packetlength) 20$: mov 4(r5) ,r1 ; Get the data length beq 40$ ; Nothing to do mov 6(r5) ,r3 ; Address of the data to send 30$: clr r0 ; Get the next character bisb (r3)+ ,r0 ; Next char setpar r0 ,(r4)+ ; Now move the data byte into the buffer inc @sp ; Packetlength := succ(packetlength) sob r1 ,30$ ; Next please 40$: clrb @r4 ; Set .asciz for call to checks mov r2 ,-(sp) ; Starting address for checksum field call checks ; Simple mov (sp)+ ,r2 ; Get the computed checksum now call spakck ; Stuff checksum into buffer now add r0 ,@sp ; And the length of the checksum setpar conpar+p.eol,(r4)+ ; End of line needed ? inc @sp ; Packetlength := succ(packetlength) mov (sp)+ ,r1 ; Packet length mov sp ,r4 ; Address(buffer) calls pakwri ,<r4,r1,#lun.ti>; And dump the buffer out now call spakfi ; Handle ibm stuff if possible add #$ALLSIZ,sp ; Pop the buffer unsave <r4,r3,r2,r1> ; Pop registers that we used return GLOBAL <CHKSIZ,CONPAR,DEBUG,SENSOP,RECSOP,SENLNG> GLOBAL <PREXON> ; /53/ .sbttl spack routines .enabl lsb spakin::bit #log$pa ,trace ; tracing today ? beq 5$ ; no calls dskdmp ,<#200$,4(r5),@r5,2(r5),6(r5)> 5$: tst pauset ; wait a moment ? beq 6$ ; no calls suspend ,<pauset> ; yes 6$: mov #conpar+p.padc,r2 ; address of the pad character ? clr r1 bisb conpar+p.npad,r1 ; send some pad characters ? tst r1 beq 20$ ; no padding 10$: calls pakwri ,<r2,#1,#lun.ti>; send some padding sob r1 ,10$ ; next please 20$: movb @r5 ,r1 ; the packet type next cmpb r1 ,#'A&137 ; a legitimate packet type ? blo 30$ ; no cmpb r1 ,#'Z&137 ; must be in the range A..Z bhi 30$ ; no good sub #100 ,r1 ; convert into range 1..26 asl r1 ; and count the packet type asl r1 ; /43/ 32 bits add #1 ,pcnt.s+2(r1) ; /43/ 32 bits, paccnt(type)++ adc pcnt.s+0(r1) ; /43/ 32 bits, the high part add #1 ,pcnt.s+2 ; /43/ 32 bits now adc pcnt.s+0 ; /43/ The high order part 30$: return .save .psect $PDATA ,D 200$: .asciz /SPACK - / .even .restore .dsabl lsb spakck: clr r0 ; checksum.len := 0 cmpb chktyp ,#defchk ; if checklength > 6 bits blos 20$ ; then begin cmpb chktyp ,#'3 ; if checktype = CRC16 bne 10$ ; then begin mov r2 ,r1 ; checkchar1:=tochar(check[12..15]) ash #-14 ,r1 ; shift over 12 bits bic #^C17 ,r1 ; mask off the high 12 bits tochar r1 ,@r4 setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) ; end 10$: mov r2 ,r1 ; checkchar1 := tochar(check[6..11]) ash #-6 ,r1 ; shift over 6 bits bic #^C77 ,r1 ; mask off the higher order bits tochar r1 ,@r4 setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) bic #^C77 ,r2 ; now drop the high bits from checks 20$: tochar r2 ,@r4 tst ranerr ; insert random checksum errors? beq 40$ ; no, please don't mov r0 ,-(sp) ;+ test mode call irand ;+ test mode tst r0 ;+ test mode bne 30$ ;+ test mode incb @r4 ;+ test mode 30$: mov (sp)+ ,r0 ;+ test mode 40$: setpar @r4 ,(r4)+ inc r0 ; packetlength := succ(packetlength) return global <chktyp ,pauset ,pcnt.s ,ranerr> .sbttl try to handle half duplex handshake garbage ala IBM (barf) spakfi: save <r2> ; don't do this forever please call 200$ ; dump raw i/o first please unsave <r2> return 200$: bit #log$io ,trace ; dumping all i/o out ? beq 230$ ; no save <r0,r1,r2,r4> ; save these please mov r1 ,r2 ; anything to do ? beq 220$ ; no 210$: clr r0 ; yes, dump ch by ch please bisb (r4)+ ,r0 ; get the next ch to dump mov #lun.lo ,r1 ; the lun to write to call putcr0 ; simple sob r2 ,210$ ; next please 220$: unsave <r4,r2,r1,r0> ; pop and exit 230$: return ; bye global <handch> .enabl lsb spakwa: save <r2> tstb handch ; any paritcular handshake char today? beq 100$ ; no, just exit please scan @r5 ,#200$ tst r0 bne 100$ mov #200 ,r2 ; a limit on looping please 10$: calls binrea ,<#lun.ti,#4> ; wait for XON, max 4 seconds please tst r0 ; did the read timeout. if so, exit. bne 90$ ; exit and try to xon the link bicb #200 ,r1 ; insure no parity is set cmpb r1 ,handch ; is this the handshake character beq 100$ ; no, try again please sob r2 ,10$ ; not forever, please br 100$ ; bye 90$: save <r0> ; save error flags calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please unsave <r0> ; pop error 100$: unsave <r2> ; pop loop index return .save .psect $PDATA ,D 200$: .byte msg$snd .byte msg$ser .byte msg$rcv .byte msg$command .byte msg$generic .byte 0 .even .restore .dsabl lsb global <ttname> .sbttl rpack$ read incoming packet ; R P A C K $ ; ; rpack$(%loc data) ; ; input: @r5 buffer address ; 2(r5) data structure of 3 words to contain the ; returned length, number and type ; ; output: r0 error code if < 0, packet type if > 0 ; 255 for checksum error ; o$len = 0 ; offset for retruned packet length o$num = 2 ; offset for returned packet number o$type = 4 ; offset for returned packet type ; ; word 2 packet type ; word 1 packet number ; as in: 2(r5) ------> word 0 packet length ; ; ; ; local data offsets from r4 (allocated on the stack ; .done = 0 ; if <> 0 then we have the packet .type = 2 ; current type of packet .ccheck = 4 ; computed checksum .rcheck = 6 ; received checksum .len = 10 ; received pakcet length .timeo = 12 ; current timeout .num = 14 ; packet number, received .size = 16 ; current size of data portion .paksi = 20 ; for loop control for data portion .cbuff = 22 ; /42/ Mark checksum buffer address .hdtype = 24 ; /42/ .lsize = 26 ; total size of local data ; internal register usage: ; ; r0 error return ; r1 current character just read from remote ; r3 pointer to temp buffer containing the packet less the SOH ; and the checksum, used for computing checksum after the ; packet has been read. ; r4 pointer to local r/w data ; r5 pointer to argument list .sbttl rpack continued .iif ndf,$ALLSIZ, $ALLSIZ = <MAXLNG+<MAXLNG/10>>&177776 rpack$::save <r1,r2,r3,r4> clr recbit ; /43/ Clear bit sum out sub #.lsize ,sp ; allocate space for local data mov sp ,r4 ; and point to it please sub #$ALLSIZ,sp ; /42/ Allocate huge buffer clr .num(r4) ; /41/ No fubar numbers on SOH tmo clr .size(r4) ; /41/ No fubar sizes on SOH timeout call waitsoh ; wait for a packet to start tst r0 ; did it work or did we timeout beq 5$ ; yes jmp 95$ ; we must have timed out then 5$: mov sp ,r3 ; the packet less SOH and checksum mov sp ,.cbuff(r4) ; /42/ Save start address clr .hdtype(r4) ; /42/ call rpakin ; initialize things 10$: tst .done(r4) ; while ( !done ) { bne 90$ ; ; call rpakrd ; Read the next character from bcs 95$ ; packet reader's buffer bisb r1 ,recbit ; /43/ So we can determine parity set bic #^C177 ,r1 ; Insure parity is cleared out cmpb r1 ,recsop ; If the character is senders SOH beq 80$ ; then we have to restart this else movb r1 ,(r3)+ ; *checkpacket++ = ch ; unchar r1 ,r0 ; Get the length packet next please mov r0 ,.hdtype(r4) ; /42/ Save header type cmp r0 ,#2 ; /42/ If the length is 0,1 or 2 then ble 15$ ; /42/ an extended header instead 14$: sub #2 ,r0 ; This is NOT an extended header so we sub chksiz ,r0 ; will check to see if the packet can bge 15$ ; hold at least SEQ+TYPE+CHECK clr r0 ; /44/ ;- add chksiz ,r0 ; Can't, thus we somehow lost the check ;- dec r0 ; sum type, so punt and reset it to a ;- movb #defchk ,chktyp ; type one checksum ;- mov #1 ,chksiz ; Fix the Checksum length also 15$: mov r0 ,.len(r4) ; Stuff the packet length call rpakrd ; As before, ask for the next character bcs 95$ ; and take an error exit if need be bisb r1 ,recbit ; /43/ So we can determine parity set bic #^C177 ,r1 ; Insure parity is cleared out cmpb r1 ,recsop ; If this is the sender's START_OF_PAK beq 80$ ; then it's time to restart the loop. movb r1 ,(r3)+ ; Insert the sequence number into the unchar r1 ,.num(r4) ; checksum packet and save the SEQ call rpakrd ; Read the TYPE field next, exiting bcs 95$ ; on a read error, of course. bisb r1 ,recbit ; /43/ So we can determine parity set bic #^C177 ,r1 ; Insure parity is cleared out cmpb r1 ,recsop ; As always, if we find the sender's beq 80$ ; START_OF_PACKET, the restart. movb r1 ,(r3)+ ; Save the TYPE field into the checksum mov r1 ,.type(r4) ; and also into the field for return. tst .hdtype(r4) ; /42/ NOW check for extended header. bne 19$ ; /42/ Not extended header. call rdexhd ; /42/ ReaD EXtended HeaDer tst r0 ; /42/ Did this work ok ? bgt 80$ ; /42/ No, got a RESYNCH bmi 96$ ; /42/ No, got a timeout or checksum 19$: mov .len(r4),.paksi(r4) ; loop for the data, if any mov @r5 ,r2 ; point to the buffer now 20$: tst .paksi(r4) ; for i := 1 to len do beq 30$ ; begin call rpakrd ; read(input,ch) bcs 95$ ; exit if error clrpar r1 ; ch := ch and chr(177B) cmpb r1 ,recsop ; if ch = SOH then resynch beq 80$ ; cmp .size(r4),#MAXLNG ; if currentsize < MAXPAKSIZE bhis 25$ ; then movb r1 ,(r2)+ ; data[i] := ch movb r1 ,(r3)+ ; checkpacket++ := ch ; end 25$: inc .size(r4) ; currentsize:=succ(currentsize) dec .paksi(r4) ; nchar_left := nchar_left - 1 br 20$ ; end 30$: clrb @r2 ; data[len] := NULL clrb @r3 ; checkpacket++ := null mov sp ,r3 ; reset base address of checkpacket call rpakck ; read the checksum now bcs 95$ ; exit on line error (like timeout) mov sp ,.done(r4) ; flag that we are done br 10$ ; check to see if we are done 80$: br 5$ ; synch error, restart the packet 90$: call rpakfi ; finish checksum and return the br 100$ 95$: mov 2(r5) ,r1 ; timeout error, flag no packet clr r0 ; nonfatal error for timout mov #timout ,o$type(r1) ; return as psuedo packet type mov #timout ,.type(r4) ; return as psuedo packet type 96$: call rpakst ; do stats and disk dumping now 100$: add #.lsize+$ALLSIZ,sp ; /42/ Pop local buffers unsave <r4,r3,r2,r1> return global <chktyp> .sbttl Read extended header type 0 for long packets ; Added edit /42/ 08-Jan-86 16:32:59 Brian Nelson rdexhd: mov r5 ,-(sp) ; /42/ Need an ODD register for MUL mov r2 ,-(sp) ; /42/ Save R2 please call rpakrd ; /42/ Extended header, read the LENX1 bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r5 ; /42/ Get the high order of length mul #95. ,r5 ; /42/ Shift over please call rpakrd ; /42/ Extended header, read the LENX2 bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r1 ; /42/ Get the next one add r1 ,r5 ; /42/ Now we have the EXTENDED length sub chksiz ,r5 ; /42/ Drop it by checksum size mov r5 ,.len(r4) ; /42/ Save it here, of course mov .cbuff(r4),r5 ; /42/ Now, at LAST, get the extended mov #5 ,r1 ; /42/ header CHECKSUM data clr -(sp) ; /42/ Accum in stack 10$: clr r0 ; /42/ Use the normal SAFE way to add bisb (r5)+ ,r0 ; /42/ bytes even though we know for add r0 ,(sp) ; /42/ that no sign extends will happen sob r1 ,10$ ; /42/ Next please mov (sp)+ ,r0 ; /42/ Pop the checksum please mov r0 ,r2 ; /42/ Save it bic #^C300 ,r2 ; /42/ Compute it as in: ash #-6 ,r2 ; /42/ Chk=char((s+((s&0300)/0100))&77) add r0 ,r2 ; /42/ ... bic #^C77 ,r2 ; /42/ Got it now call rpakrd ; /42/ Extended header, read the HCHECK bcs 90$ ; /42/ field, exiting on read errors. bic #^C177 ,r1 ; /42/ Insure parity is cleared out cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS beq 80$ ; /42/ START_OF_HEADER please movb r1 ,(r3)+ ; /42/ Save into Checksum buffer unchar r1 ,r1 ; /42/ Convert to actual checksum now cmpb r1 ,r2 ; /42/ Do the CHECKSUMS match ? bne 85$ ; /42/ No, exit with such set please clr r0 ; /42/ It worked, exit normally br 100$ ; /42/ bye... 80$: mov #1 ,r0 ; /42/ Resynch time br 100$ ; /42/ Exit 85$: mov #badchk ,r0 ; /42/ Header Checksum error br 95$ ; /42/ Stuff the error 90$: mov #timout ,r0 ; /42/ Return timeout error 95$: mov 2(sp) ,r5 ; /42/ Return timeout error mov 2(r5) ,r1 ; /42/ Get address of result block clr o$len(r1) ; /42/ Clear this also mov r0 ,o$type(r1) ; /42/ Return the error mov r0 ,.type(r4) ; /42/ Here also please mov #-1 ,r0 ; /42/ Fatal error 100$: mov (sp)+ ,r2 ; /42/ Pop r2 and mov (sp)+ ,r5 ; /42/ Restore R5 return .sbttl subroutines for RPACK only .enabl lsb rpakrd: calls binrea ,<#lun.ti,.timeo(r4)>; read(input,ch) tst r0 ; did it work bne 110$ ; no call rawio ; perhaps raw i/o logging bit #log$rp ,trace ; dump to a local terminal ? beq 20$ ; no cmpb r1 ,recsop ; start of a packet ? beq 10$ ; yes movb r1 ,-(sp) ; yes, stuff the ch onto the stack mov sp ,r1 ; point to it print r1 ,#1 ; dump it clr r1 ; restore what we read and exit bisb (sp)+ ,r1 ; restore it and exit br 20$ ; bye 10$: print #200$ ; start of a packet 20$: clr r0 ; no errors clc ; it worked return ; bye 110$: save <r0> ; save the error code calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please unsave <r0> ; restore the error code sec ; flag the error return ; bye .save .psect $PDATA ,D 200$: .asciz <cr><lf>/<SOH>/ .even .restore .dsabl lsb rpakin: clr .done(r4) ; done := false clr .type(r4) ; packettype := 0 clr .ccheck(r4) ; checksum := 0 clr .rcheck(r4) ; received_checksum := 0 clr .len(r4) ; current length := 0 clr .num(r4) ; packet_number := 0 clr .timeo(r4) ; timeout := 0 clr .size(r4) ; current size of data part of packet clr .paksi(r4) ; loop control for data of packet mov @r5 ,r0 ; initialize the buffer to null mov #40 ,r1 10$: clrb (r0)+ ; simple clrb (r0)+ ; simple sob r1 ,10$ mov 2(r5) ,r0 ; return parameters clr (r0)+ ; packet.length := 0 clr (r0)+ ; packet.number := 0 clr (r0)+ ; packet.type := 0 call settmo mov r0 ,.timeo(r4) return settmo: mov sertim ,r0 ; if waiting for server command bne 20$ ; then use that timeout clr r0 ; bisb conpar+p.time,r0 ; get the remotes timeout bne 10$ ; ok mov #mytime ,r0 ; no good, setup a timeout 10$: cmpb r0,setrec+p.time ; use SET TIMEOUT value if > bhis 20$ ; no, use the timeout as in clr r0 ; ok, use the value the user said bisb setrec+p.time,r0 ; in the SET TIMEOUT command bne 20$ ; must be > 0 by now mov #mytime ,r0 ; no ?? 20$: return global <conpar ,setrec ,sertim> .sbttl finish up rpack rpakfi: mov r3 ,-(sp) ; compute correct checksum type call checks ; simple mov (sp)+ ,.ccheck(r4) ; and stuff it in please cmpb .ccheck(r4),.rcheck(r4) ; compare computed checksum with the beq 100$ ; actual checksum mov #badchk ,.type(r4) ; flag checksum error 100$: mov 2(r5) ,r1 ; where to return some things mov .len(r4),o$len(r1) ; return the packet length mov .type(r4),o$type(r1) ; and the packet type mov .num(r4),o$num(r1) ; and at last, the packet number call rpakst ; do stats and logging now call rpaklo ; possibly log checksum errors? return .enabl lsb rpakst: cmpb .type(r4),#'A&137 ; count the packet types for stats blo 110$ ; bad packet type cmpb .type(r4),#'Z&137 ; must in the range A..Z bhi 110$ ; definiately a bad packet movb .type(r4),r1 ; packet is ok, add it to the stats sub #100 ,r1 ; convert to 1..26 asl r1 ; to word offsets asl r1 ; /43/ Double word offsets add #1 ,pcnt.r+2(r1) ; /43/ 32 bit addition today adc pcnt.r+0(r1) ; /43/ The high order part of it add #1 ,pcnt.r+2 ; /43/ Add it in here also adc pcnt.r+0 ; /43/ High order part 110$: bit #log$pa ,trace ; tracing today ? beq 120$ ; no calls dskdmp ,<#200$,.len(r4),.type(r4),.num(r4),@r5> 120$: return .save .psect $PDATA ,D 200$: .asciz /RPACK - / .even .restore .dsabl lsb .enabl lsb rpaklo: save <r0> cmp .rcheck(r4),.ccheck(r4) ; checksums match ? beq 100$ ; yes, do nothing then bit #log$io ,trace ; not if in raw i/o mode bne 100$ ; forget it sub #60 ,sp ; dump bad checksums out to disk mov sp ,r1 ; point to the buffer copyz #200$ ,r1 ; a header strlen r1 ; length so far add r0 ,r1 ; point to the end of it deccvt .rcheck(r4),r1 ; convert to decimal add #6 ,r1 ; move along please deccvt .ccheck(r4),r1 ; the calculated checksum add #6 ,r1 ; make it .asciz clrb @r1 ; simple mov sp ,r1 ; point back to the buffer strlen r1 ; get the length calls putrec ,<r1,r0,#lun.lo>; dump buffer to disk add #60 ,sp ; pop buffer and exit 100$: unsave <r0> ; pop r0 and exit return .save .psect $PDATA ,D 200$: .asciz /?Bad Checksum: rcv,calc are / .even .restore .dsabl lsb global <pcnt.r ,sertim ,trace> .sbttl read and convert the checksum for RPACK rpakck: save <r3> ; use r3 for accumulating check clr r3 ; assume zero for now call rpakrd ; read(input,ch) bcs 110$ ; exit if error bisb r1 ,recbit ; recbit |= ch ; bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r3 ; received_check := ch cmpb chktyp ,#defchk ; if len(checksum) > 8bits blos 10$ ; then begin ash #6 ,r3 ; check := check * 64 call rpakrd ; read(input,ch) bcs 110$ ; exit if error bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r1 ; ch := unchar(ch) bisb r1 ,r3 ; rcheck := rcheck + ch cmpb chktyp ,#'3 ; if checktype = CRC16 bne 10$ ; then ash #6 ,r3 ; begin call rpakrd ; check := check * 64 bcs 110$ ; check := check + ch bic #^c177 ,r1 ; ch := ch and 177B unchar r1 ,r1 ; bisb r1 ,r3 ; end ; 10$: clc br 120$ 110$: sec 120$: mov r3 ,.rcheck(r4) ; return the checksum unsave <r3> return .sbttl parity routines ; C L R P A R ; ; input: 2(sp) the character to clear parity for ; output: 2(sp) the result ; ; caller by CLRPAR macro ; ; If parity is set to anything but NONE then always ; clear the parity out else clear it if and only if ; filetype is not image mode. clrpar::tstb parity ; handle nothing please (no parity) beq 10$ ; yes cmpb parity ,#par$no ; set parity none used ? bne 20$ ; no, must be some other type 10$: tst image ; no parity, image mode today ? bne 100$ ; yes, leave things alone please 20$: bic #^C177 ,2(sp) ; no, clear bits 7-15 please 100$: return ; bye global <parity> .sbttl compute proper checksum please ; C H E C K S ; ; input: 2(sp) address of .asciz string to compute checksum for ; output: @sp the computed checksum checks::save <r0,r1,r2,r3> ; save registers we may use mov 12(sp) ,r2 ; point to the string to do it for clr 12(sp) ; assume a zero checksum ? cmpb chktyp ,#'3 ; CRC-CCITT type today ? bne 5$ ; no strlen r2 ; yes, get the .asciz string length calls crcclc ,<r2,r0> ; compute the CRC16-CCITT mov r0 ,r2 ; stuff the result into r2 for later br 90$ ; and exit 5$: clr r1 ; init the checksum accumulator 10$: clr r3 ; get the next ch please bisb (r2)+ ,r3 ; got the next ch now beq 20$ ; hit the end of the string cmpb parity ,#par$no ; did the packet contain parity? beq 15$ ; no, leave bit 7 alone bic #^C177 ,r3 ; yes, please clear bit seven 15$: bic #170000 ,r1 ; /42/ Insure long packet not overflow add r3 ,r1 ; check := check + ch br 10$ 20$: mov r1 ,r2 ; checksum := (((checksum and 300B)/64) cmpb chktyp ,#'2 ; 12 bit sum type checksum ? beq 30$ ; yes, just exit bic #^C300 ,r2 ; +checksum) and 77B) ash #-6 ,r2 ; add r1 ,r2 ; bic #^C77 ,r2 br 90$ 30$: bic #170000 ,r2 ; type 2 checksum 90$: mov r2 ,12(sp) ; return the checksum 100$: unsave <r3,r2,r1,r0> ; exit return .sbttl crc calculation ; This routine will calculate the CRC for a string, using the ; CRC-CCIT polynomial. ; ; The string should be the fields of the packet between but ; not including the <mark> and the block check, which is ; treated as a string of bits with the low order bit of the ; first character first and the high order bit of the last ; character last -- this is how the bits arrive on the ; transmission line. The bit string is divided by the ; polynomial ; ; x^16+x^12+x^5+1 ; ; The initial value of the CRC is 0. The result is the ; remainder of this division, used as-is (i.e. not ; complemented). ; ; From 20KERMIT.MAC, rewritten for PDP11 by Brian Nelson ; 13-Jan-84 08:50:43 ; ; input: @r5 string address ; 2(r5) string length ; output: r0 crc crcclc::save <r1,r2,r3,r4,r5> ; save registers please clr r0 ; initialize the CRC to zero mov @r5 ,r3 ; get the string address now mov 2(r5) ,r4 ; get the string length beq 100$ ; oops, nothing to do then 10$: clr r1 ; get the next character please bisb (r3)+ ,r1 ; please avoid pdp11 sign extend cmpb parity ,#par$no ; did the packet have parity? beq 20$ ; no, leave bit seven alone bic #^C177 ,r1 ; yes, clear bit seven please 20$: ixor r0 ,r1 ; add in with the current CRC mov r1 ,r2 ; get the high four bits ash #-4 ,r2 ; and move them over to 3..0 bic #^C17 ,r2 ; drop any bits left over bic #^C17 ,r1 ; and the low four bits asl r1 ; times 2 for word addressing asl r2 ; times 2 for word addressing mov crctb2(r1),r1 ; get low portion of CRC factor ixor crctab(r2),r1 ; simple (limited modes for XOR) swab r0 ; shift off a byte from previous crc bic #^C377 ,r0 ; clear new high byte ixor r1 ,r0 ; add in the new value sob r4 ,10$ ; next please 100$: unsave <r5,r4,r3,r2,r1> ; pop saved r1-r5 return ; Data tables for CRC-CCITT generation .save .psect $PDATA ,D crctab: .word 0 .word 10201 .word 20402 .word 30603 .word 41004 .word 51205 .word 61406 .word 71607 .word 102010 .word 112211 .word 122412 .word 132613 .word 143014 .word 153215 .word 163416 .word 173617 crctb2: .word 0 .word 10611 .word 21422 .word 31233 .word 43044 .word 53655 .word 62466 .word 72277 .word 106110 .word 116701 .word 127532 .word 137323 .word 145154 .word 155745 .word 164576 .word 174367 .restore .sbttl clear stats out ; C L R S T A ; ; clear out the packet counts by packet type from the last ; transaction and add them into the total running count by ; packet type. clrsta::save <r0,r1,r2> ; save the registers we use mov #pcnt.r ,r1 ; packets received mov totp.r ,r2 ; running count so far mov #34 ,r0 ; number of works to add/clear 10$: add 2(r1) ,2(r2) ; /43/ Add in the totals adc (r2) ; /43/ The carryover also add (r1) ,(r2)+ ; /43/ The HIGH order of it tst (r2)+ ; /43/ Get to the next one clr (r1)+ ; /43/ Clear of old stuff out clr (r1)+ ; /43/ Clear of old stuff out sob r0 ,10$ ; /43/ Next please mov #pcnt.s ,r1 ; now for the packets sent mov totp.s ,r2 ; where to add them in mov #34 ,r0 ; number of words to do 20$: add 2(r1) ,2(r2) ; /43/ Add in the totals adc (r2) ; /43/ The carryover also add (r1) ,(r2)+ ; /43/ The HIGH order of it tst (r2)+ ; /43/ Get to the next one clr (r1)+ ; /43/ Clear of old stuff out clr (r1)+ ; /43/ Clear of old stuff out sob r0 ,20$ ; /43/ Next please clr pcnt.n ; naks count clr pcnt.n+2 ; /43/ rest of it clr pcnt.t ; /44/ Timeouts clr pcnt.t+2 ; /44/ Timeouts clr filein+0 ; /43/ File data stats clr filein+2 ; /43/ File data stats clr fileout+0 ; /43/ File data stats clr fileout+2 ; /43/ File data stats clr charin+0 ; /43/ Physical link stats clr charin+2 ; /43/ Physical link stats clr charout+0 ; /43/ Physical link stats clr charout+2 ; /43/ Physical link stats unsave <r2,r1,r0> ; pop the registers we used return ; and exit incsta::call seconds ; /43/ Get current seconds since mov #times+4,r2 ; /43/ midnight, moving old times mov r0 ,(r2)+ ; /43/ Insert NEW times first mov r1 ,(r2) ; /43/ then subtact off the old sub times+2 ,(r2) ; /43/ times from it sbc -(r2) ; /43/ ditto for the carry sub times ,(r2) ; /43/ Incremental is in times+4 mov r1 ,-(r2) ; /43/ and times+6, new time is in mov r0 ,-(r2) ; /43/ times+0 and time+2 return ; /43/ Exit global <pcnt.n ,pcnt.r ,pcnt.s ,totp.r ,totp.s> global <charin,charout,filein,fileout,seconds,times> ; /43/ global <pcnt.t> ; /44/ .sbttl waitsoh wait for a packet start (ascii 1, SOH) ; W A I T S O H ; ; input: nothing ; output: r0 error code ; r1 the SOH or NULL if we timed out ; ; ; As of edit 2.41 (25-Dec-85 13:26:26) from Steve Heflin we will ; exit Kermit-11 if we find that the first thing we find is a CTL ; Z (\032). This is desired in case the user accidentilly put the ; Kermit-11 into server without setting a line. ; On edit /44/, wait for TWO control z's in a row to exit. waitsoh:clr r1 ; Start with nothing clr -(sp) ; /56/ Hold virgin copy of data mov #2 ,-(sp) ; /44/ Counter for control Z's 10$: cmpb r1 ,recsop ; wait for a packet header please beq 40$ ; ok, exit call settmo ; get proper timeout set up calls binrea ,<#lun.ti,r0> ; read with timeout mov r1 ,2(sp) ; /56/ Save it bic #^C177 ,r1 ; /44/ Never want parity here tst r0 ; did the read work ? bne 30$ ; oops, just exit then cmpb r1 ,#'Z&37 ; /41/ Control Z returned ? bne 15$ ; /41/ No dec (sp) ; /44/ Should we REALLY exit now? bne 20$ ; /44/ No, in case we got some NOISE call clostt ; /41/ Yes, drop terminal and exit jmp exit ; /41/ Bye now 15$: mov #2 ,(sp) ; /44/ Need TWO ^Z's in a row to exit 20$: call rawio ; all is not well, perhaps dump packets br 10$ ; loop back for finding a PACKET start 30$: clr r1 ; Timeout, return( NULL ) br 100$ ; /56/ 40$: bitb #200 ,2(sp) ; /56/ Parity perhaps? beq 100$ ; /56/ No cmpb parity ,#PAR$NONE ; /56/ 8bit channel? bne 100$ ; /56/ No inc incpar ; /56/ Yes, also want message only once 100$: cmp (sp)+ ,(sp)+ ; /56/ Pop control Z counter return ; exit global <conpar ,sertim ,clostt ,exit> GLOBAL <incpar> rawio: bit #log$io ,trace ; dumping all i/o today? beq 100$ ; no save <r0,r1> ; yes, save these please clr r0 bisb r1 ,r0 ; and setup call to putcr0 mov #lun.lo ,r1 ; the unit to write to call putcr0 ; simple unsave <r1,r0> ; pop these now 100$: return .sbttl initialize repeat count for sending inirepeat:: save <r0,r1> clr dorpt ; assume not doing repeat things tst setrpt ; user disable repeat count processing? beq 100$ ; yes cmpb #myrept ,#40 ; am I doing it ? beq 100$ ; no, just exit then clr rptcount ; size of repeat if zero clr rptlast ; no last character please (a null) mov #-1 ,rptinit ; need to prime the pump please movb conpar+p.rept,r0 ; check for doing so beq 100$ ; no cmpb r0 ,#40 ; a space also ? beq 100$ ; yes cmpb r0 ,senpar+p.rept ; same ? bne 100$ ; no movb r0 ,rptquo ; yes, save it mov #-1 ,dorpt ; and we are indeed doing this 100$: clc unsave <r1,r0> return global <dorpt,rptcount,rptlast,rptquo,rptsave,rptinit,setrpt> .sbttl BUFFIL buffer from the file that is being sent ; B U F F I L ; ; input: @r5 buffer address ; output: r0 rms sts error code ; r1 length of the string buffil::save <r2,r3,r4,r5> ; save all registers we may use mov @r5 ,r4 ; point to the destination address clr r3 ; use as a length counter clr r5 ; bitb #CAPA.L,conpar+p.capas ; /42/ Check to see if both sides beq 4$ ; /42/ REALLY understand long packets bitb #CAPA.L,senpar+p.capas ; /42/ We would normally but it is beq 4$ ; /42/ possible to SET NOLONG mov senlng ,r5 ; /42/ Does receiver understand bne 5$ ; /42/ long packets today? 4$: bisb conpar+p.spsiz,r5 ; get the recievers maximum size 5$: sub #14 ,r5 ; being overcautious today ? 10$: tst dorpt ; are we doing repeat counts beq 50$ ; no 15$: call gnc ; getnext character ; bcs 30$ ; if ( error ) then break ; tst rptinit ; if ( firsttime ) beq 20$ ; then clr rptinit ; rptinit = 0 ; clr rptcount ; rptcount = 0 ; movb r1 ,rptlast ; rptlast = ch ; 20$: cmpb r1 ,rptlast ; if ( ch == rptlast ) bne 30$ ; then cmp rptcount,#94. ; bge 30$ inc rptcount ; rptcount++ ; br 15$ ; else break ; 30$: mov r1 ,rptsave ; save the failed character please tst rptcount ; this may be EOF on first character beq 90$ ; if so, we simply do nothing at all cmp rptcount,#2 ; please don't bother with ONE char. bgt 40$ ; don't waste the overhead for two 35$: clr r1 ; avoid sign extension please bisb rptlast ,r1 ; get the character to write call 200$ ; and stuff it into the buffer dec rptcount ; more to insert ? bne 35$ ; yes br 45$ ; no, exit 40$: movb rptquo ,(r4)+ ; insert the repeat count quote inc r3 ; count it in the packet size tochar rptcount,(r4)+ ; convert the repeat count to a char inc r3 ; and count in the packet size clr r1 ; bisb rptlast ,r1 ; and insert the repeated character call 200$ ; insert it into the buffer 45$: movb rptsave ,rptlast ; make the failing character the one clr rptcount ; in case of EOF, set this please tst r0 ; was this the end of file ? bne 90$ ; yes, we had better leave then inc rptcount ; no, initialize the count please br 70$ ; and check for overflow in the buffer 50$: call gnc ; getnextchar ; bcs 90$ ; if ( eof ) then break ; call 200$ ; get the character stuff w/o repeats 70$: cmp r3 ,r5 ; room for the data ? blo 10$ ; end 90$: mov r3 ,r1 ; return the length please beq 100$ ; nothing there clr r0 ; say read was successful 100$: unsave <r5,r4,r3,r2> ; and exit return .sbttl actually quote and stuff the character in for BUFFIL 200$: tst do8bit ; exit if status <> success; beq 210$ ; if need_8_bit_prefix tstb r1 ; and bit_test(ch,200B) bpl 210$ ; then begin movb ebquot ,(r4)+ ; buffer[i] := eight_bit_quote inc r3 ; i := succ(i) bicb #200 ,r1 ; ch := bit_clear(ch,200b) 210$: clr r2 ; end ; bisb r1 ,r2 ; ch0_7 := ch bic #^C177 ,r2 ; ch0_7 := ch0_7 and 177B cmpb r2 ,#SPACE ; if ch0_7 < space blo 220$ ; or cmpb r2 ,#DEL ; ch0_7 = del beq 220$ ; or cmpb r2 ,senpar+p.qctl ; ch0_7 = quote beq 220$ ; or tst do8bit ; ( need_8_bit_prefix ) beq 215$ ; and ( ch0_7 == binaryquote ) cmpb r2 ,ebquot ; beq 220$ ; or 215$: tst dorpt ; ( doing_repeatcompression ) beq 230$ ; and ( ch0_7 == repeatquote ) cmpb r2 ,rptquo ; bne 230$ ; then ; begin 220$: movb senpar+p.qctl,(r4)+ ; buffer[i] := quote inc r3 ; length := succ(length) cmpb r2 ,#37 ; if ( ch0_7 < SPACE ) blos 225$ ; or cmpb r2 ,#del ; ( ch0_7 == DEL ) bne 230$ ; then 225$: ctl r1 ,r1 ; ch := ctl(ch) ctl r2 ,r2 ; ch0_7 := ctl(ch0_7) 230$: tst image ; if image_mode beq 240$ ; then movb r1 ,(r4)+ ; buffer[i] := ch br 250$ ; else 240$: movb r2 ,(r4)+ ; buffer[i] := ch0_7 250$: inc r3 ; length := succ( length ) return gnc: mov #lun.in ,r0 add #1 ,fileout+2 ; /43/ Stats on file data adc fileout+0 ; /43/ 32 bits call getcr0 tst r0 beq 100$ sec return 100$: clc return global <getcr0 ,image ,conpar> .sbttl bufpak buffil but get data from a buffer ; input: @r5 source buffer, .asciz ; output: 2(r5) destination buffer ; r0 zero (ie, no errors are possible) ; r1 string length ; ; No 8 bit prefixing and no repeat counts will be done. ; This routine is used for encoding string to be sent as ; generic commands to a server. bufpak::save <r2,r3,r4,r5> ; save all registers we may use mov 2(r5) ,r4 ; point to the destination address mov @r5 ,r5 ; the source string clr r3 ; use as a length counter 10$: clr r1 ; ch := buffer[i] bisb (r5)+ ,r1 ; avoid PDP-11 sign extension beq 90$ ; clr r2 ; bisb r1 ,r2 ; ch0_7 := ch ' bic #^C177 ,r2 ; ch0_7 := ch0_7 and 177B cmpb r2 ,#space ; if ch0_7 < space blo 20$ ; or cmpb r2 ,#del ; ch0_7 = del beq 20$ ; or cmpb r2 ,senpar+p.qctl ; ch0_7 = quote bne 40$ ; then ; begin 20$: movb senpar+p.qctl,(r4)+ ; buffer[i] := quote inc r3 ; length := succ(length) cmpb r2 ,senpar+p.qctl ; if ch0_7 <> quote beq 30$ ; then begin ctl r1 ,r1 ; ch := ctl(ch) ctl r2 ,r2 ; ch0_7 := ctl(ch0_7) end 30$: ; end 40$: tst image ; if image_mode beq 50$ ; then movb r1 ,(r4)+ ; buffer[i] := ch br 60$ ; else 50$: movb r2 ,(r4)+ ; buffer[i] := ch0_7 60$: inc r3 ; length := succ( length ) 70$: clr -(sp) bisb conpar+p.spsiz,@sp ; exit if length > spsize-8 bne 80$ ; if spsiz = 0 mov #maxpak ,@sp ; then maxsize := #maxpak 80$: sub #10 ,@sp ; cmp r3 ,(sp)+ ; blo 10$ ; end 90$: mov r3 ,r1 ; return the length please clr r0 ; say read was successful unsave <r5,r4,r3,r2> ; and exit return .sbttl bufemp dump a buffer out to disk ; B U F E M P ; ; bufemp(%loc buffer,%val len) ; ; input: @r5 buffer address ; 2(r5) length ; output: r0 error bufemp::save <r1,r2,r3,r4> ; save temps as usual mov @r5 ,r2 ; input record address mov 2(r5) ,r3 ; string length clr r0 ; insure no error for a null packet 10$: tst r3 ; anything left in the record? ble 100$ ; no 20$: clr r0 ; get the next character bisb (r2)+ ,r0 ; into a convienient place dec r3 ; chcount-- ; mov #1 ,r4 ; repeat_count = 1 ; tst dorpt ; are we doing repeat count stuff? beq 30$ ; no cmpb r0 ,rptquo ; yes, is this the aggreed upon prefix? bne 30$ ; no dec r3 ; chcount-- clr r4 ; yes, get the next character then bisb (r2)+ ,r4 ; and decode it into a number bic #^C177 ,r4 ; insure no parity bits are hanging unchar r4 ,r4 ; simple to do clr r0 ; now prime CH with the next character bisb (r2)+ ,r0 ; so we can check for other types of dec r3 ; quoting to be done. tst r4 ; insure the count is legitimate bgt 30$ ; it's ok mov #1 ,r4 ; it's fubar, fix it 30$: clr set8bit ; assume we don't have to set bit 7 tst do8bit ; must we do 8 bit unprefixing? beq 60$ ; no cmpb r0 ,ebquot ; yes, is this the 8 bit prefix? bne 60$ ; no mov sp ,set8bit ; yes, send a flag to set the bit clr r0 ; and get the next character bisb (r2)+ ,r0 ; without sign extension dec r3 ; one less character left in buffer 60$: cmpb r0 ,conpar+p.qctl ; is this a quoted character? bne 70$ ; no clr r0 ; yes, get the next character bisb (r2)+ ,r0 ; must be one you know dec r3 ; chcount := pred(chcount) clr r1 ; must avoid sign extension here bisb r0 ,r1 ; check low 7 bits against quote bic #^C177 ,r1 ; drop 7..15 cmpb r1 ,conpar+p.qctl ; if ch <> myquote beq 70$ ; then cmpb r1 ,#77 ; if ( ch & 177 ) >= ctl(DEL) blo 70$ ; and ( ch & 177 ) <= ctl(del)+40 cmpb r1 ,#137 ; then bhi 70$ ; ch = ctl(ch) ; ctl r0 ,r0 ; 70$: tst set8bit ; do we need to set the high bit? beq 74$ ; no bisb #200 ,r0 ; yes, set the bit on please 74$: mov r0 ,-(sp) ; and save the character to write 75$: mov #lun.ou ,r1 ; channel_number := lun.out tst outopn ; is there really something open? bne 80$ ; yes, put the data to it clr r1 ; no, direct the output to a terminal 80$: mov @sp ,r0 ; restore the character to write out call putcr0 ; and do it add #1 ,filein+2 ; /43/ Stats adc filein+0 ; /43/ 32 bits worth sob r4 ,75$ ; duplicate the character if need be. tst (sp)+ ; pop the stack where we saved CH br 10$ ; next character please 100$: unsave <r4,r3,r2,r1> return global <do8bit ,ebquot ,putcr0 ,outopn ,senpar ,set8bit> global <dorpt ,rptquo > .sbttl bufunpack like bufemp, but return data to a buffer ; input: @r5 source buffer, .asciz ; output: 2(r5) destination buffer ; r0 zero (ie, no errors are possible) ; r1 string length ; ; No 8 bit prefixing and no repeat counts will be done. ; This routine is used for decoding strings received for ; generic commands to the server. bufunp::save <r2,r3,r4,r5> ; save temps as usual mov @r5 ,r2 ; input record address clr r3 ; length := 0 mov 2(r5) ,r4 ; resultant string ; 10$: clr r0 ; get the next character bisb (r2)+ ,r0 ; into a convienient place beq 100$ ; All done bic #^C177 ,r0 ; /53/ Always seven bit data mov #1 ,r5 ; /53/ Assume character not repeated tst dorpt ; /53/ Repeat processing off? beq 20$ ; /53/ Yes, ignore. cmpb r0 ,rptquo ; /53/ Is this a repeated char? bne 20$ ; /53/ No, normal processing bisb (r2)+ ,r5 ; /53/ Yes, get the repeat count bic #^C177 ,r5 ; /53/ Always seven bit data unchar r5 ,r5 ; /53/ Get the value tst r5 ; /53/ Good data bgt 15$ ; /53/ Yes mov #1 ,r5 ; /53/ No, fix it 15$: clr r0 ; /53/ Avoid sign extension bisb (r2)+ ,r0 ; /53/ Now get the real data bic #^C177 ,r0 ; /53/ Always seven bit data 20$: cmpb r0 ,senpar+p.qctl ; is this a quoted character? bne 30$ ; no clr r0 ; yes, get the next character bisb (r2)+ ,r0 ; must be one you know clr r1 ; must avoid sign extension here bisb r0 ,r1 ; check low 7 bits against quote bic #^C177 ,r1 ; drop 7..15 cmpb r1 ,senpar+p.qctl ; if ch <> myquote beq 30$ ; then ctl r0 ,r0 ; ch := ctl(ch); 30$: movb r0 ,(r4)+ ; copy the byte over now inc r3 ; length := succ(length) sob r5 ,30$ ; /53/ Perhaps data was repeated br 10$ ; next character please 100$: clrb @r4 ; make the string .asciz mov r3 ,r1 ; return the length clr r0 ; fake no errors please unsave <r5,r4,r3,r2> ; pop registers and exit return global <spar ,rpar ,fixchk> .sbttl printm print message if not remote ; P R I N T M ; ; input: @r5 arg count ; 2(r5) text for message #1 ; 4(r5) and so on .enabl lsb printm::save <r0,r1,r5> ; save registers we will use mov (r5)+ ,r1 ; get the message count beq 100$ ; nothing to do tst inserv ; skip if a server bne 100$ ; bye tst remote ; skip if we are the remote bne 100$ ; yep message message <Kermit: > ; a header 10$: mov (r5)+ ,r0 .print r0 ; now loop thru printing the stuff sob r1 ,10$ ; next please message ; a <cr><lf> clr logini ; may need a logging header 100$: unsave <r5,r1,r0> ; pop temps return ; and exit global <logini,remote> .dsabl lsb .sbttl error message printing ; E R R O R ; ; error(%val msgcount,%loc msg1, %loc msg2,....) ; ; Error sends the message text if we are remote else ; it prints it out as in the baseline KERMIT.C erbfsiz = 84. error:: save <r1,r2,r3,r4,r5> tst remote ; if not remote then printm(...) bne 10$ ; we are the remote. send errors call printm ; simple br 100$ ; bye 10$: mov (r5)+ ,r1 ; message count beq 100$ ; nothing to do ? sub #erbfsiz+2,sp ; remote, allocate a text buffer mov sp ,r4 ; and point to it please movb #'% ,(r4)+ ; /35/ insert dec style 'warning' mov #erbfsiz-1,r2 ; length so far mov #prompt ,r0 ; /32/ insert prompt into error text 20$: movb (r0)+ ,(r4)+ ; /32/ copy the prompt text over beq 25$ ; /32/ all done, found a null (asciz) dec r2 ; /32/ one less place to store text br 20$ ; /32/ next prompt character please 25$: dec r4 ; /32/ backup to the null we copied. cmpb -1(r4) ,#'> ; /35/ get rid of the trailing '>' bne 26$ ; /35/ no movb #'- ,-1(r4) ; /35/ change it to form 'Kermit-11-' 26$: movb #40 ,(r4)+ ; /32/ insert a space into buffer dec r2 ; /32/ one less available tst r2 ; /32/ did we possibly run out of room? bgt 30$ ; /32/ no mov sp ,r4 ; /32/ yes, forget about the prompt. mov #erbfsiz,r2 ; /32/ yes, also reset the space avail 30$: mov (r5)+ ,r3 ; get the next message please 40$: movb (r3)+ ,@r4 ; now copy it to the buffer until beq 50$ ; we get an ascii null (chr(0)) cmpb @r4 ,#'$ ; apparently CPM systems don't like bne 45$ ; dollar symbols ? movb #'_ ,@r4 ; so stuff a '_' in instead 45$: inc r4 sob r2 ,40$ ; no, go until we get one or run br 60$ ; out of space to put it 50$: movb #40 ,(r4)+ ; insert a space in there dec r2 ; insure sufficient space beq 60$ ; no sob r1 ,30$ ; and get the next message 60$: clrb @r4 ; inaure .asciz mov sp ,r4 ; all done, send the ERROR packet strlen r4 ; get the length spack #'E,paknum,r0,r4 ; and send it add #erbfsiz+2,sp ; deallocate the text buffer 100$: unsave <r5,r4,r3,r2,r1> ; and exit return global <paknum ,prompt ,remote> .sbttl print received error packet out ; P R E R R P ; ; prerrp(%loc msg) ; ; input: @r5 address of .asciz string to print .enabl lsb prerrp::.print #200$ .print @r5 .newli clr logini return .save .psect $PDATA ,D .enabl lc 200$: .asciz /Aborting with error from remote./<CR><LF> .even .restore .dsabl lsb global <logini> .sbttl send/print several common types of errors ; M$TYPE(%val(type),%loc(packet)) unknown packet type recieved ; M$RETRY retry abort ; M$SYNCH out of synch ; ; 18-Oct-84 17:34:37 BDN debugging for PRO/RT11 Kermit m$type::save <r0> ; save temps that we will use clr -(sp) ; a buffer for the packet type movb @r5 ,@sp ; the packet type mov sp ,r0 ; point back to the buffer calls error ,<#4,#e$type,r0,#e$hd,2(r5)> tst (sp)+ ; pop local buffer unsave <r0> ; pop temp and exit return m$retr::save <r0> ; save r0 please bitb #200 ,recbit ; /44/ Perhaps parity was going ? beq 10$ ; /44/ No cmpb parity ,#PAR$NO ; /44/ Yes, do we know about parity bne 10$ ; /44/ Yes we do, normal abort calls error ,<#1,#e$par> ; /44/ No parity, ctl fields have br 100$ ; /44/ Exit 10$: calls error ,<#1,#e$retr> ; send/print the error message 100$: unsave <r0> ; pop and exit return ; bye m$sync::save <r0> ; save r0 please calls error ,<#1,#e$synch> ; send/print the error message unsave <r0> ; pop and exit return ; bye .save .psect $pdata e$hd: .asciz / pak: / e$type: .asciz /Fubar pak type: / e$retr: .asciz /Retry limit reached/ e$synch:.asciz /Hopelessly out of synch with sending Kermit/ e$par: .asciz /Retry limit reached, parity is possibly being introduced/ .even .restore .sbttl get next file to send ; G E T N X T ; ; input: srcnam possibly wildcarded filename ; index flag if eq 0 then this is the first time thru ; output: filnam next file to do ; r0 <> 0 then abort ; ; RSTS and RSX11M/M+ ; ; Lookup uses the RMS version 2 $SEARCH macro to do the directory ; operation. For RT11 we will simply NOP the $SEARCH since RT11 ; does not support directory lookup operations in the EXEC. Thus ; the error codes ER$NMF (no more files) and ER$FNF are referenced ; directly here. getnxt::save <r1> calls lookup ,<#3,#srcnam,#index,#filnam> tst r0 ; did it work ? beq 100$ ; yes cmp r0 ,#ER$NMF ; no more files matching name ? beq 20$ ; yes, we are all done then cmp r0 ,#ER$FNF ; how about file not found ? bne 30$ ; no, print the error message out 20$: tst index ; sent any files yet ? bne 100$ ; yes, that's ok then mov #ER$FNF ,r0 ; no, convert ER$NMF to ER$FNF 30$: mov r0 ,-(sp) ; save r0 please calls syserr ,<r0,#errtxt> ; not so good. Get the error text mov #filnam ,r1 ; assume the filename parse worked calls fparse ,<#srcnam,#filnam>; quite possibly it may not have tst r0 ; so decide whether to send the beq 40$ ; origonal name or the expanded mov #srcnam ,r1 ; filename in the error packet. 40$: calls error ,<#2,#errtxt,r1>; and send/print it out mov (sp)+ ,r0 ; pop saved error code from lookup 100$: unsave <r1> return global <er$fnf ,er$nmf ,errtxt ,filnam ,index ,srcnam> .sbttl xor and scanch l$xor:: save <r0> mov 4(sp) ,r0 ixor #100 ,r0 mov r0 ,4(sp) unsave <r0> return ; S C A N C H ; ; input: 4(sp) the string address ; 2(sp) the character to look for ; output: r0 position of ch in string scanch::save <r2> ; save temps mov 6(sp) ,r2 ; get address of the string clr r0 ; initial found position 10$: tstb @r2 ; end of the string yet ? beq 90$ ; yes inc r0 ; no, pos := succ(pos) cmpb 4(sp) ,(r2)+ ; does the ch match the next one? bne 10$ ; no, try again br 100$ ; yes, exit loop 90$: clr r0 ; failure, return postion = 0 100$: unsave <r2> ; pop r2 mov @sp ,4(sp) ; move return address up cmp (sp)+ ,(sp)+ ; pop stack return ; and exit ; random things for testing irand:: tst testc bne 10$ mov #1234. ,testc 10$: mov testc ,r0 mov r1 ,-(sp) mov r0 ,r1 ash #-4 ,r1 bic #170000 ,r1 xor r1 ,r0 ash #13 ,r1 bic #100000 ,r1 xor r1 ,r0 bic #100000 ,r0 mov r0 ,testc ash #-13 ,r0 mov (sp)+ ,r1 return global <testc> .sbttl compute parity for an outgoing 8 bit link ; This is software parity generation as some DEC interfaces ; and some DEC executives don't know how to compute parity. ; There are two methods given here for ODD and EVEN genera- ; tion. One is from Frank da Cruz's 20KERMIT.MAC and does it ; by computing it. The other method is from the pascal RT11 ; Kermit (by Phil Murton) and does a table lookup to compute ; the parity. For the sake of speed and the fact that some RT ; systems lack certain instructions we will use the later ; method at a slight cost in space. parlok = 1 ; use table lookup method .assume par$od eq 1 ; set parity odd .assume par$ev eq 2 ; set parity even .assume par$ma eq 3 ; set parity mark .assume par$sp eq 4 ; set parity space .assume par$no eq 5 ; set parity none .psect $pdata pardsp: .word none.p, odd.p, even.p ,mark.p ,spac.p ,none.p .psect $code dopari::save <r0,r1,r2,r3> ; save things we will use mov parity ,r3 ; get the current parity setting asl r3 ; times 2 mov 12(sp) ,r1 ; get the character to do it to jsr pc ,@pardsp(r3) ; and dispatch as desired mov r1 ,12(sp) ; return the character please unsave <r3,r2,r1,r0> ; pop and exit return none.p: return ; do nothing mark.p: bisb #200 ,r1 ; mark means we are always high return ; on bit seven spac.p: bicb #200 ,r1 ; space means we are always low return ; on bit seven .sbttl odd/even parity generation .if eq ,parlok ; what kind of parity generation .ift ; to use even.p: bic #^c177 ,r1 ; insure no high bits are set mov r1 ,r2 ; copy call par ; and do it return odd.p: bic #^c177 ,r1 ; insure only bits 0..6 mov r1 ,r2 ; copy it bisb #200 ,r2 ; and set bit seven call par ; do it return ; bye par: mov #200 ,r3 ; xor instruction is strange ash #-4 ,r2 ; move the high four bits down bic #^C17 ,r2 ; clear bit 7's right propagation ixor r1 ,r2 ; fold source character into one bic #^C17 ,r2 ; insure we have only 4 bits today mov r2 ,r3 ; now check if bits 2 and 3 are asr r3 ; /2 asr r3 ; /2 cmpb r3 ,#3 ; both high or both low beq 10$ ; both high tstb r3 ; both low ? bne 20$ ; no, don't set any parity then 10$: ixor #200 ,r1 ; yes, toggle parity now 20$: bic #^C3 ,r2 ; ok, now see if the low 2 bits are cmpb r2 ,#3 ; both either on or off beq 30$ ; both are on, set parity tstb r2 ; perhaps only one bit is on? bne 40$ ; yep 30$: ixor #200 ,r1 ; toggle the bit then 40$: return ; bye .endc ; if eq, parlok .sbttl odd/even parity generation via lookup .if ne ,parlok ; use this method ? .ift ; yes odd.p: bic #^c177 ,r1 tstb partab(r1) bne 100$ bisb #200 ,r1 100$: return even.p: bic #^c177 ,r1 tstb partab(r1) beq 100$ bisb #200 ,r1 100$: return ; Table of parity setting for ascii 0-177 ; From Phil Murton's RTLINE.PAS .save .psect $PDATA ,D partab: .byte 0,1,1,0,1,0,0,1 ; first 8 ascii characters .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 .byte 1,0,0,1,0,1,1,0 .byte 1,0,0,1,0,1,1,0 .byte 0,1,1,0,1,0,0,1 ; last eight ascii characters (to 177) .restore .endc ; if ne, parlok .end